home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / ADV350.ZIP / closex.for < prev    next >
Encoding:
Text File  |  1990-11-17  |  9.1 KB  |  267 lines
  1.       SUBROUTINE CLOSEX(IRET)
  2. C
  3.       INCLUDE 'ADVCOM.COM'
  4.       INCLUDE 'NEWCOM.COM'
  5.       INCLUDE 'FUNCT.H'
  6.       
  7. C
  8. C  TRANSFER TO REQUIRED PROCESSING SECTION
  9. C
  10.       GOTO(10000,11000,12000,12200,12400,12600,13000,19000,20000),IRET
  11. C
  12. C  CAVE CLOSING AND SCORING
  13. C
  14. C  THESE SECTIONS HANDLE THE CLOSING OF THE CAVE.  THE CAVE CLOSES "CLOCK1"
  15. C  TURNS AFTER THE LAST TREASURE HAS BEEN LOCATED (INCLUDING THE PIRATE'S
  16. C  CHEST, WHICH MAY OF COURSE NEVER SHOW UP).  NOTE THAT THE TREASURES NEED NOT
  17. C  HAVE BEEN TAKEN YET, JUST LOCATED.  HENCE CLOCK1 MUST BE LARGE ENOUGH TO GET
  18. C  OUT OF THE CAVE (IT ONLY TICKS WHILE INSIDE THE CAVE).  WHEN IT HITS ZERO,
  19. C  WE BRANCH TO 10000 TO START CLOSING THE CAVE, AND THEN SIT BACK AND WAIT FOR
  20. C  HIM TO TRY TO GET OUT.  IF HE DOESN'T WITHIN CLOCK2 TURNS, WE CLOSE THE
  21. C  CAVE; IF HE DOES TRY, WE ASSUME HE PANICS, AND GIVE HIM A FEW ADDITIONAL
  22. C  TURNS TO GET FRANTIC BEFORE WE CLOSE.  WHEN CLOCK 2 HITS ZERO, WE BRANCH TO
  23. C  11000 TO TRANSPORT HIM INTO THE FINAL PUZZLE.  NOTE THAT THE PUZZLE DEPENDS
  24. C  UPON ALL SORTS OF RANDOM THINGS.  FOR INSTANCE, THERE MUST BE NO WATER OR
  25. C  OIL, SINCE THERE ARE BEANSTALKS WHICH WE DON'T WANT TO BE ABLE TO WATER,
  26. C  SINCE THE CODE CAN'T HANDLE IT.  ALSO, WE CAN HAVE NO KEYS, SINCE THERE IS A
  27. C  GRATE (HAVING MOVED THE FIXED OBJECT!) THERE SEPARATING HIM FROM ALL THE
  28. C  TREASURES.  MOST OF THESE PROBLEMS ARISE FROM THE USE OF NEGATIVE PROP
  29. C  NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS UNTIL HE'S ACTUALLY MOVED THE
  30. C  OBJECTS.
  31.  
  32. C  WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY THE BRIDGE, KILL
  33. C  ALL THE DWARVES (AND THE PIRATE), REMOVE THE TROLL AND BEAR (UNLESS DEAD),
  34. C  AND SET "CLOSNG" TO TRUE.  LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE IT.
  35. C  FROM NOW UNTIL CLOCK2 RUNS OUT, HE CANNOT UNLOCK THE GRATE, MOVE TO ANY
  36. C  LOCATION OUTISDE THE CAVE (LOC<9), OR CREATE THE BRIDGE.  NOR CAN HE BE
  37. C  RESURRECTED IF HE DIES.  NOTE THAT THE SNAKE IS ALREADY GONE, SINCE HE GOT
  38. C  TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING.  ALSO, HE'S
  39. C  GOTTEN THE PEARL, SO WE KNOW THE BIVALVE IS AN OYSTER.  *AND*, THE DWARVES
  40. C  MUST HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST.
  41.  
  42. 10000 PROP(GRATE)=0
  43.       PROP(FISSUR)=0
  44.       DO 10010 I=1,6
  45.       DSEEN(I)=.FALSE.
  46. 10010 DLOC(I)=0
  47.       CALL MOVE(TROLL,0)
  48.       CALL MOVE(TROLL+100,0)
  49.       CALL MOVE(TROLL2,PLAC(TROLL))
  50.       CALL MOVE(TROLL2+100,FIXD(TROLL))
  51.       CALL JUGGLE(CHASM)
  52.       IF(PROP(BEAR).NE.3) CALL DSTROY(BEAR)
  53.       PROP(CHAIN)=0
  54.       FIXED(CHAIN)=0
  55.       PROP(AXE)=0
  56.       FIXED(AXE)=0
  57.       CALL RSPEAK(129)
  58.       CLOCK1=-1
  59.       CLOSNG=.TRUE.
  60.       GOTO 19999
  61.       
  62. C  ONCE HE'S PANICKED, AND CLOCK2 HAS RUN OUT, WE COME HERE TO SET UP THE
  63. C  STORAGE ROOM.  THE ROOM HAS TWO LOCS, HARDWIRED AS 115 (NE) AND 116 (SW).
  64. C  AT THE NE END, WE PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, A BED OF
  65. C  OYSTERS, A PILE OF LAMPS, RODS WITH STARS, SLEEPING DWARVES, AND HIM.  AND
  66. C  THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS,
  67. C  MORE RODS, AND PILLOWS.  A MIRROR STRETCHES ACROSS ONE WALL.  MANY OF THE
  68. C  OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G., THE SNAKE IS KNOWN TO
  69. C  HAVE BEEN DESTROYED AND NEEDN'T BE CARRIED AWAY FROM ITS OLD "PLACE"),
  70. C  MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY.  WE ALSO DROP ALL OTHER
  71. C  OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME WHICH COULD CAUSE TROUBLE,
  72. C  SUCH AS THE KEYS).  WE DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK.
  73.  
  74. 11000 PROP(BOTTLE)=PUT(BOTTLE,115,1)
  75.       PROP(PLANT)=PUT(PLANT,115,0)
  76.       PROP(OYSTER)=PUT(OYSTER,115,0)
  77.       PROP(LAMP)=PUT(LAMP,115,0)
  78.       PROP(ROD)=PUT(ROD,115,0)
  79.       PROP(DWARF)=PUT(DWARF,115,0)
  80.       LOC=115
  81.       OLDLOC=115
  82.       NEWLOC=115
  83.       
  84. C  LEAVE THE GRATE WTIH NORMAL (NON-NEGATIVE) PROPERTY.
  85.  
  86.       FOO=PUT(GRATE,116,0)
  87.       PROP(SNAKE)=PUT(SNAKE,116,1)
  88.       PROP(BIRD)=PUT(BIRD,116,1)
  89.       PROP(CAGE)=PUT(CAGE,116,0)
  90.       PROP(ROD2)=PUT(ROD2,116,0)
  91.       PROP(PILLOW)=PUT(PILLOW,116,0)
  92.       
  93.       PROP(MIRROR)=PUT(MIRROR,115,0)
  94.       FIXED(MIRROR)=116
  95.       
  96.       DO 11010 I=1,100
  97. 11010 IF(TOTING(I)) CALL DSTROY(I)
  98.  
  99.       CALL RSPEAK(132)
  100.       CLOSED=.TRUE.
  101.       GOTO 2
  102.       
  103. C  ANOTHER WAY WE CAN FORCE AN END TO THINGS IS BY HAVING THE LAMP GIVE OUT.
  104. C  WHEN IT GETS CLOSE, WE COME HERE TO WARN HIM.  WE GO TO 12000 IF THE LAMP
  105. C  AND FRESH BATTERIES ARE HERE, IN WHICH CASE WE REPLACE THE BATTERIES AND
  106. C  CONTINUE.  12200 IS FOR OTHER CASES OF LAMP DYING.  12400 IS WHEN IT GOES
  107. C  OUT, AND 12600 IS IF HE'S WANDERED OUTSIDE AND THE LAMP IS USED UP, IN WHICH
  108. C  CASE WE FORCE HIM TO GIVE UP.
  109.  
  110. 12000 CALL RSPEAK(188)
  111.       PROP(BATTER)=1
  112.       IF(TOTING(BATTER)) CALL DROP(BATTER,LOC)
  113.       LIMIT=LIMIT+2500
  114.       LMWARN=.FALSE.
  115.       GOTO 19999
  116.       
  117. 12200 IF(LMWARN.OR..NOT.HERE(LAMP)) GOTO 19999
  118.       LMWARN=.TRUE.
  119.       SPK=187
  120.       IF(PLACE(BATTER).EQ.0) SPK=183
  121.       IF(PROP(BATTER).EQ.1) SPK=189
  122.       CALL RSPEAK(SPK)
  123.       GOTO 19999
  124.       
  125. 12400 LIMIT=-1
  126.       PROP(LAMP)=0
  127.       IF(HERE(LAMP)) CALL RSPEAK(184)
  128.       GOTO 19999
  129.       
  130. 12600 CALL RSPEAK(185)
  131.       GAVEUP=.TRUE.
  132.       GOTO 20000
  133.       
  134. C  AND, OF COURSE, DEMO GAMES ARE ENDED BY THE WIZARD.
  135.  
  136. 13000 CALL MSPEAK(1)
  137.       GOTO 20000
  138.       
  139. C  OH DEAR, HE'S DISTURBED THE DWARVES.
  140.  
  141. 19000 CALL RSPEAK(136)
  142.  
  143. C  EXIT CODE.  WILL EVENTUALLY INCLUDE SCORING.  FOR NOW, HOWEVER, ...
  144.  
  145. C  THE PRESENT SCORING ALGORITHM IS AS FOLLOWS:
  146. C     OBJECTIVE:          POINTS:        PRESENT TOTAL POSSIBLE:
  147. C  GETTING WELL INTO CAVE   25                    25
  148. C  EACH TREASURE < CHEST    12                    60
  149. C  TREASURE CHEST ITSELF    14                    14
  150. C  EACH TREASURE > CHEST    16                   144
  151. C  SURVIVING             (MAX-NUM)*10             30
  152. C  NOT QUITTING              4                     4
  153. C  REACHING "CLOSNG"        25                    25
  154. C  "CLOSED": QUIT/KILLED    10
  155. C            KLUTZED        25
  156. C            WRONG WAY      30
  157. C            SUCCESS        45                    45
  158. C  CAME TO WITT'S END        1                     1
  159. C  ROUND OUT THE TOTAL       2                     2
  160. C                                       TOTAL:   350
  161. C  (POINTS CAN ALSO BE DEDUCTED FOR USING HINTS.)
  162.  
  163. 20000 SCORE=0
  164.       MXSCOR=0
  165.       
  166. C  FIRST TALLY UP THE TREASURES.  MUST BE IN BUILDING AND NOT BROKEN.
  167. C  GIVE THE POOR GUY 2 POINTS JUST FOR FINDING EACH TREASURE.
  168.  
  169.       DO 20010 I=50,MAXTRS
  170.       IF(PTEXT(I).EQ.0) GOTO 20010
  171.       K=12
  172.       IF(I.EQ.CHEST) K=14
  173.       IF(I.GT.CHEST) K=16
  174.       IF(PROP(I).GE.0) SCORE=SCORE+2
  175.       IF(PLACE(I).EQ.3.AND.PROP(I).EQ.0) SCORE=SCORE+K-2
  176.       MXSCOR=MXSCOR+K
  177. 20010 CONTINUE
  178.  
  179. C  NOW LOOK AT HOW HE FINISHED AND HOW FAR HE GOT.  MAXDIE AND NUMDIE TELL US
  180. C  HOW WELL HE SURVIVED.  GAVEUP SAYS WHETHER HE EXITED VIA QUIT.  DFLAG WILL
  181. C  TELL US IF HE EVER GOT SUITABLY DEEP INTO THE CAVE.  CLOSNG STILL INDICATES
  182. C  WHETHER HE REACHED THE ENDGAME.  AND IF HE GOT AS FAR AS "CAVE CLOSED"
  183. C  (INDICATED BY "CLOSED"), THEN BONUS IS ZERO FOR MUNDANE EXITS OR 133, 134,
  184. C  135 IF HE BLEW IT (SO TO SPEAK).
  185.  
  186.       SCORE=SCORE+(MAXDIE-NUMDIE)*10
  187.       MXSCOR=MXSCOR+MAXDIE*10
  188.       IF(.NOT.(SCORNG.OR.GAVEUP)) SCORE=SCORE+4
  189.       MXSCOR=MXSCOR+4
  190.       IF(DFLAG.NE.0) SCORE=SCORE+25
  191.       MXSCOR=MXSCOR+25
  192.       IF(CLOSNG)SCORE=SCORE+25
  193.       MXSCOR=MXSCOR+25
  194.       IF(.NOT.CLOSED) GOTO 20020
  195.       IF(BONUS.EQ.0) SCORE=SCORE+10
  196.       IF(BONUS.EQ.135) SCORE=SCORE+25
  197.       IF(BONUS.EQ.134) SCORE=SCORE+30
  198.       IF(BONUS.EQ.133) SCORE=SCORE+45
  199. 20020 MXSCOR=MXSCOR+45
  200.  
  201. C  DID HE COME TO WITT'S END AS HE SHOULD?
  202.  
  203.       IF(PLACE(MAGZIN).EQ.108) SCORE=SCORE+1
  204.       MXSCOR=MXSCOR+1
  205.       
  206. C  ROUND IT OFF.
  207.  
  208.       SCORE=SCORE+2
  209.       MXSCOR=MXSCOR+2
  210.       
  211. C  DEDUCT POINTS FOR HINTS.  HINTS < 4 ARE SPECIAL; SEE DATABASE DESCRIPTION.
  212.  
  213.       DO 20030 I=1,HNTMAX
  214. 20030 IF(HINTED(I)) SCORE=SCORE-HINTS(I,2)
  215.  
  216. C  RETURN TO SCORE COMAND IF THAT'S WHERE WE CAME FROM.
  217.  
  218.       IF(SCORNG) GOTO 8241
  219.       
  220. C  THAT SHOULD BE GOOD ENOUGH.  LET'S TELL HIM ALL ABOUT IT.
  221.  
  222.       WRITE(*,20100) SCORE,MXSCOR,TURNS
  223. 20100 FORMAT(///' YOU SCORED',I4,' OUT OF A POSSIBLE',I4,
  224.      1          ', USING',I5,' TURNS.')
  225.      
  226.       DO 20200 I=1,CLSSES
  227.       IF(CVAL(I).GE.SCORE) GOTO 20210
  228. 20200 CONTINUE
  229.       WRITE(*,20202)
  230. 20202 FORMAT(/' YOU JUST WENT OFF MY SCALE!!'/)
  231.       GOTO 25000
  232. 20210 CALL SPEAK(CTEXT(I))
  233.       IF(I.EQ.CLSSES-1) GOTO 20220
  234.       K=CVAL(I)+1-SCORE
  235.       KK='S.'
  236.       IF(K.EQ.1) KK='. '
  237.       WRITE(*,20212) K,KK
  238. 20212 FORMAT(/' TO ACHIEVE THE NEXT HIGHER RATING, YOU NEED',I3,
  239.      1        ' MORE POINT',A2/)
  240.       GOTO 25000
  241.       
  242. 20220 WRITE(*,20222)
  243. 20222 FORMAT(/' TO ACHIEVE THE NEXT HIGHER RATING ',
  244.      1        'WOULD BE A NEAT TRICK!'//' CONGRATULATIONS!!'/)
  245.      
  246.       GOTO 25000
  247. C
  248. C  SET COMPLETION CODE FOR RETURN TO THE CALLING ROUTINE.
  249. C
  250. 19999 CONTINUE
  251.       IRET=1
  252.       RETURN
  253. C
  254.     2 CONTINUE
  255.       IRET=2
  256.       RETURN
  257. C
  258.  8241 CONTINUE
  259.       IRET=3
  260.       RETURN
  261. C
  262. 25000 CONTINUE
  263.       IRET=4
  264.       RETURN
  265.       END
  266.  
  267.